home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / PowerMacOberon 1.2 / Source / Elems / FontElems.Mod (.txt) < prev    next >
Oberon Text  |  1995-08-22  |  4KB  |  94 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 19 Jul 95
  5. Syntax10b.Scn.Fnt
  6. MODULE FontElems;    (** HM 
  7. IMPORT Viewers, Fonts, Texts, TextFrames, Oberon, PopupElems;
  8.     Elem* = POINTER TO ElemDesc;
  9.     ElemDesc* = RECORD (PopupElems.ElemDesc)
  10.     END;
  11.     ext: ARRAY 16 OF CHAR;
  12. PROCEDURE SplitFont (name: ARRAY OF CHAR; VAR family, style: ARRAY OF CHAR; VAR size: INTEGER);
  13.     VAR i: INTEGER;
  14. BEGIN
  15.     style[0] := 0X; size := 0; i := 0;
  16.     WHILE (name[i] # 0X) & ((name[i] < "0") OR (name[i] > "9")) DO family[i] := name[i]; INC(i) END;
  17.     family[i] := 0X;
  18.     WHILE (name[i] # 0X) & (name[i] >= "0") & (name[i] <= "9") DO
  19.         size := 10*size + ORD(name[i]) - ORD("0"); INC(i)
  20.     END;
  21.     IF (CAP(name[i]) = "I") OR (CAP(name[i]) = "B") THEN style[0] := name[i]; style[1] := 0X END
  22. END SplitFont;
  23. PROCEDURE MakeFont (family, style: ARRAY OF CHAR; size: INTEGER; VAR name: ARRAY OF CHAR);
  24.     VAR i, j: INTEGER; d: ARRAY 5 OF CHAR; ch: CHAR;
  25. BEGIN
  26.     i := 0; WHILE family[i] # 0X DO name[i] := family[i]; INC(i) END;
  27.     j := 0; REPEAT d[j] := CHR(size MOD 10 + ORD("0")); size := size DIV 10; INC(j) UNTIL size = 0;
  28.     REPEAT DEC(j); name[i] := d[j]; INC(i) UNTIL j = 0;
  29.     IF style # "" THEN name[i] := style[0]; INC(i) END;
  30.     j := 0; REPEAT ch := ext[j]; name[i] := ch; INC(i); INC(j) UNTIL ch = 0X
  31. END MakeFont;
  32. PROCEDURE Change (t: Texts.Text; beg, end: LONGINT; family, style: ARRAY OF CHAR; size: INTEGER);
  33.     VAR r: Texts.Reader; pos, org: LONGINT; ch: CHAR; fnt : Fonts.Font; fam, sty: ARRAY 32 OF CHAR; siz: INTEGER;
  34.         name: ARRAY 64 OF CHAR;
  35. BEGIN
  36.     pos := beg; Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
  37.     WHILE pos < end DO
  38.         org := pos; fnt := r.fnt;
  39.         REPEAT INC(pos); Texts.Read(r, ch) UNTIL (pos >= end) OR (r.fnt # fnt);
  40.         SplitFont(fnt.name, fam, sty, siz);
  41.         IF family # "" THEN COPY(family, fam) END;
  42.         IF (style = "b") OR (style = "i") THEN COPY(style, sty) ELSIF style = "p" THEN sty := "" END;
  43.         IF size # 0 THEN siz := size END;
  44.         MakeFont(fam, sty, siz, name); fnt := Fonts.This(name);
  45.         IF (fnt # NIL) & (fnt.name = name) THEN Texts.ChangeLooks(t, org, pos, {0}, fnt, 0, 0) END
  46. END Change;
  47. PROCEDURE Exec (e: Elem; pos: LONGINT);
  48.     VAR t: Texts.Text; s: Texts.Scanner; style, family: ARRAY 32 OF CHAR; size: INTEGER; beg, end, time: LONGINT;
  49. BEGIN
  50.     Oberon.GetSelection(t, beg, end, time);
  51.     IF time >= 0 THEN
  52.         style := ""; family := ""; size := 0;
  53.         Texts.OpenScanner(s, e.menu, pos); Texts.Scan(s);
  54.         IF (s.class IN {Texts.Name, Texts.String}) & (s.line = 0) THEN
  55.             IF s.s = "plain" THEN style := "p"
  56.             ELSIF s.s = "italic" THEN style := "i"
  57.             ELSIF s.s = "bold" THEN style := "b"
  58.             ELSE COPY(s.s, family)
  59.             END;
  60.             Change(t, beg, end, family, style, size)
  61.         ELSIF (s.class = Texts.Int) & (s.line = 0) THEN
  62.             size := SHORT(s.i);
  63.             Change(t, beg, end, family, style, size)
  64.         END
  65. END Exec;
  66. PROCEDURE Handle* (e: Texts.Elem; VAR m: Texts.ElemMsg);
  67.     VAR e1: Elem;
  68. BEGIN
  69.     WITH e: Elem DO
  70.         WITH
  71.             m: Texts.CopyMsg DO
  72.                 NEW(e1); m.e := e1; PopupElems.Handle(e, m)
  73.         |  m: Texts.IdentifyMsg DO
  74.                 m.mod := "FontElems"; m.proc := "Alloc"
  75.         |  m: PopupElems.ExecMsg DO Exec(e, m.pos)
  76.         ELSE PopupElems.Handle(e, m)
  77.         END
  78. END Handle;
  79. PROCEDURE Alloc*;
  80.     VAR e: Elem;
  81. BEGIN
  82.     NEW(e); e.handle := Handle; Texts.new := e
  83. END Alloc;
  84. PROCEDURE Insert*;
  85.     VAR e: Elem; insert: TextFrames.InsertElemMsg;
  86. BEGIN
  87.     NEW(e); e.handle := Handle; e.name := "Font"; e.small := TRUE; 
  88.     e.menu := TextFrames.Text(""); PopupElems.MeasureMenu(e);
  89.     insert.e := e; Viewers.Broadcast(insert)
  90. END Insert;
  91. BEGIN
  92.     ext := ".Scn.Fnt"
  93. END FontElems.
  94.